home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue49 / Build / makeprjres.dpr < prev    next >
Encoding:
Text File  |  1999-06-20  |  5.5 KB  |  158 lines
  1. {$APPTYPE CONSOLE}
  2. {$H+,O+}
  3. {Based on the work of Hector Santos.}
  4.  
  5. program MakePrjRes;
  6.  
  7. uses
  8.   Windows,
  9.   SysUtils,
  10.   IniFiles;
  11.  
  12. const
  13.   HexNibble: array [0..15] of char = '0123456789ABCDEF';
  14.  
  15.   function HexByte(b: byte): string;
  16.   begin
  17.     HexByte := HexNibble[b shr 4]+HexNibble[b AND $F];
  18.   end; { HexByte }
  19.  
  20.   function HexWord(w: word): string;
  21.   begin
  22.     Result := HexByte(w shr 8)+HexByte(w AND $FF);
  23.   end; { HexWord }
  24.  
  25.   function OptAddExtension(fName, ext: string): string;
  26.   begin
  27.     if Pos('.',fName) = 0
  28.       then Result := fName+'.'+ext
  29.       else Result := fName;
  30.   end; { OptAddExtension }
  31.  
  32.   procedure MakeResource(dofFile, icoFile, rcFile: string);
  33.   var
  34.     rcf: text;
  35.  
  36.     procedure WriteVersionResource;
  37.     var
  38.       ini     : TIniFile;
  39.       sect    : string;
  40.       sBuild  : string;
  41.       locale  : word;
  42.       codepage: word;
  43.       flags   : string;
  44.  
  45.       procedure AddFlag(fl: string);
  46.       begin
  47.         if flags <> '' then flags := flags + ' | ';
  48.         flags := flags + fl;
  49.       end;
  50.  
  51.     begin
  52.       // TIniFile opens file in windows dir by default!
  53.       if Pos('\',dofFile) = 0 then dofFile := '.\'+dofFile;
  54.       if not FileExists(dofFile) then begin
  55.         Writeln('MakeProjectResource 1.01');
  56.         Writeln('file ',dofFile,' does not exist!');
  57.         Halt(1);
  58.       end;
  59.       ini := TIniFile.Create(dofFile);
  60.       try
  61.         Writeln(rcf, 'VS_VERSION_INFO VERSIONINFO');
  62.         sect:='Version Info';
  63.         sBuild:=ini.ReadString(sect, 'MajorVer', '1');
  64.         sBuild:=sBuild+', '+ini.ReadString(sect, 'MinorVer', '0');
  65.         sBuild:=sBuild+', '+ini.ReadString(sect, 'Release', '0');
  66.         sBuild:=sBuild+', '+ini.ReadString(sect, 'Build', '0');
  67.         Writeln(rcf, 'FILEVERSION      ', sBuild);
  68.         Writeln(rcf, 'PRODUCTVERSION   ', sBuild);
  69.         flags := '';
  70.         if ini.ReadInteger(sect,'Debug',0) = 1      then AddFlag('VS_FF_DEBUG');
  71.         if ini.ReadInteger(sect,'PreRelease',0) = 1 then AddFlag('VS_FF_PRERELEASE');
  72.         if ini.ReadInteger(sect,'Special',0) = 1    then AddFlag('VS_FF_SPECIALBUILD');
  73.         if ini.ReadInteger(sect,'Private',0) = 1    then AddFlag('VS_FF_PRIVATEBUILD');
  74.         if flags = '' then flags := '0';
  75.         sect:='Version Info Keys';
  76.         Writeln(rcf, 'FILEFLAGSMASK  VS_FFI_FILEFLAGSMASK');
  77.         Writeln(rcf, 'FILEFLAGS  ', flags);
  78.         Writeln(rcf, 'FILEOS   VFT_APP');
  79.         Writeln(rcf, 'FILESUBTYPE  VFT2_UNKNOWN');
  80.         Writeln(rcf, 'BEGIN');
  81.         Writeln(rcf, '  BLOCK "VerFileInfo"');
  82.         Writeln(rcf, '  BEGIN');
  83.         locale := Ini.ReadInteger(sect,'Locale',$409);
  84.         codepage := Ini.ReadInteger(sect,'CodePage',1252);
  85.         Writeln(rcf, '   Value "TRANSLATION", 0x',HexWord(locale),', ',codepage);
  86.         Writeln(rcf, '  END');
  87.         Writeln(rcf, '  BLOCK "STRINGFILEINFO"');
  88.         Writeln(rcf, '  BEGIN');
  89.         Writeln(rcf, '    BLOCK "',HexWord(locale),HexWord(codepage),'"');
  90.         Writeln(rcf, '    BEGIN');
  91.         Writeln(rcf, '     VALUE "CompanyName", "',Ini.ReadString(Sect,'CompanyName',''),' \0"');
  92.         Writeln(rcf, '     VALUE "FileDescription", "',Ini.ReadString(Sect,'FileDescription',''),' \0"');
  93.         Writeln(rcf, '     VALUE "FileVersion", "',Ini.ReadString(Sect,'FileVersion',sBuild),' \0"');
  94.         Writeln(rcf, '     VALUE "InternalName", "',Ini.ReadString(Sect,'InternalName',''),' \0"');
  95.         Writeln(rcf, '     VALUE "LegalCopyright", "',Ini.ReadString(Sect,'LegalCopyRight',''),' \0"');
  96.         Writeln(rcf, '     VALUE "LegalTrademarks", "',Ini.ReadString(Sect,'LegalTrademarks',''),' \0"');
  97.         Writeln(rcf, '     VALUE "OriginalFileName", "',Ini.ReadString(Sect,'OriginalFileName',''),' \0"');
  98.         Writeln(rcf, '     VALUE "ProductName", "',Ini.ReadString(Sect,'ProductName',''),' \0"');
  99.         Writeln(rcf, '     VALUE "ProductVersion", "',Ini.ReadString(Sect,'ProductVersion',''),' \0"');
  100.         Writeln(rcf, '     VALUE "Comments", "',Ini.ReadString(Sect,'Comments',''),' \0"');
  101.         Writeln(rcf, '    END');
  102.         Writeln(rcf, '  END');
  103.         Writeln(rcf, 'END');
  104.       finally ini.free; end;
  105.     end; { WriteVersionResource }
  106.  
  107.     procedure WriteIconResource;
  108.     begin
  109.       if not FileExists(icoFile) then begin
  110.         Writeln('MakeProjectResource 1.01');
  111.         Writeln('file ',icoFile,' does not exist!');
  112.         Halt(1);
  113.       end;
  114.       Writeln(rcf,'MAINICON ICON "',icoFile,'"');
  115.     end; { WriteIconResource }
  116.  
  117.   begin
  118.     AssignFile(rcf, rcFile);
  119.     Rewrite(rcf);
  120.     if icoFile <> '-' then WriteIconResource;
  121.     if dofFile <> '-' then begin
  122.       if icoFile <> '-' then Writeln(rcf);
  123.       WriteVersionResource;
  124.     end;
  125.     CloseFile(rcf);
  126.   end; { MakeResource }
  127.  
  128.   procedure Usage;
  129.   begin
  130.     Writeln('MakeProjectResource 1.01');
  131.     Writeln('Usage: makeprjres dof_file ico_file [rc_file]');
  132.     Writeln('       makeprjres -        ico_file [rc_file]');
  133.     Writeln('       makeprjres dof_file -        [rc_file]');
  134.     Halt(1);
  135.   end; { Usage }
  136.  
  137. var
  138.   dofFile: string;
  139.   icoFile: string;
  140.   rcFile : string;
  141.  
  142. begin
  143.   if (ParamCount < 2) or (ParamCount > 3) then Usage;
  144.   dofFile := ParamStr(1);
  145.   icoFile := ParamStr(2);
  146.   if icoFile <> '-' then begin
  147.     OptAddExtension(icoFile,'ICO');
  148.     rcFile := ChangeFileExt(icoFile,'.RC');
  149.   end;
  150.   if dofFile <> '-' then begin
  151.     OptAddExtension(dofFile,'DOF');
  152.     rcFile := ChangeFileExt(dofFile,'.RC');
  153.   end;
  154.   if ParamCount = 3 then rcFile := OptAddExtension(ParamStr(3),'RC');
  155.   MakeResource(dofFile, icoFile, rcFile);
  156. end.
  157.  
  158.